home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.04 Apr 87 / forth source / forth benchmark
Encoding:
Text File  |  1987-02-06  |  5.1 KB  |  182 lines  |  [TEXT/MACA]
  1. ( Screen invert, Mach2 and Mac+ version)
  2. only forth also assembler also sane
  3. 501504 524288 + constant screenlow ( Mac Plus)
  4. 5472 constant screenwords
  5. screenlow screenwords 4 * + constant screenhigh
  6.  
  7. code i@
  8.     move.l  d6,a0
  9.     move.l (a0),-(a6)
  10.     rts
  11. end-code
  12. mach
  13.  
  14. code i!
  15.     move.l  d6,a0
  16.     move.l (a6)+,(a0)
  17.     rts
  18. end-code
  19. mach
  20.  
  21. code i+
  22.     add.l   d6,(a6)
  23.     rts
  24. end-code
  25. mach
  26.  
  27. code 3+
  28.     addq.l  #3,(a6)
  29.     rts
  30. end-code
  31. mach
  32.  
  33. code center
  34.     move.l  d6,a0
  35.     move.l  (a0),-(a6)
  36.     not.l   (a6)
  37.     move.l  (a6)+,(a0)
  38.     rts
  39. end-code
  40. mach
  41.  
  42. : invert screenlow 
  43.     begin dup @ not over ! 4 + dup screenhigh = until drop ;
  44. : test counter 50 0 do invert loop timer ;
  45.  
  46. : invert2 screenhigh screenlow do i @ not i ! 4 +loop ;
  47. : test2 counter 50 0 do invert2 loop timer ;
  48.  
  49. : invert3 screenhigh screenlow do i@ not i! 4 +loop ;
  50. : test3 counter 50 0 do invert3 loop timer ;
  51.  
  52. : invert4 screenhigh screenlow do center 4 +loop ;
  53. : test4 counter 50 0 do invert4 loop timer ;
  54.  
  55. ( screen inverter, definitions for MacForth, slightly altered )
  56. anew bench
  57. assembler
  58. 501504 524288 + constant screenlow ( Mac Plus)
  59. 5472 constant screenwords
  60. screenlow screenwords 4 * + constant screenhigh
  61. : SHOW.TIME  ( ticks -- )
  62.     dup cr .
  63.     ." ticks     "
  64.     100 60 */ <# # # ascii . hold #s #> type
  65.     ."  seconds" ;
  66. : counter tickcount ;
  67. : timer tickcount swap - show.time ;
  68.  
  69. CODE bnot 
  70.     d0 get, d0 long not, d0 put, next 
  71. END-CODE
  72.  
  73. : invert1 screenlow
  74.   begin dup @ bnot over ! 4 + dup screenhigh = until drop ;
  75. : test tickcount 50 0 do invert1 loop
  76.   tickcount swap - show.time ;
  77.  
  78. : invert2 screenhigh screenlow do i @ bnot i ! 4 +loop ;
  79. : test2 tickcount 50 0 do invert2 loop
  80.   tickcount swap - show.time ;
  81.  
  82. : invert3 screenhigh screenlow do i@ bnot i! 4 +loop ;
  83. : test3 tickcount 50 0 do invert3 loop
  84.   tickcount swap - show.time ;
  85.  
  86. : invert4 screenhigh screenlow
  87.   do  >CODE
  88.    d6 a0 long move,
  89.    d5 a0 long adda,
  90.    a0 () long not,
  91.    >FORTH
  92.   4 +loop
  93. ;
  94. : test4 tickcount
  95.   50 0 do invert4 loop tickcount swap - show.time ;
  96.  
  97. ( Eratosthenes Sieve Benchmark, stack version )                                
  98.  8192 constant size       
  99. variable flags  size vallot     ( ALLOT for MacForth Plus)         
  100. : primes   flags  size 1 fill  ( empty array )                
  101.   0 ( prime counter )   size 0  ( range )                       
  102.     do  flags  i+ c@                                          
  103.       if   i 2* 3+  dup  i+  size <  ( avoid known nonprimes)  
  104.          if  size flags +  over i+  flags +                     
  105.              do  0 i c!  dup  +loop  ( flick mod prime flags) 
  106.          then     drop 1+  ( another prime )                    
  107.        then                                                     
  108.     loop                                                        
  109. ;                                            
  110.                                                                 
  111. : sieve 10 0 do  primes loop ;    
  112. : sieve.demo counter sieve3 timer ;
  113.                                                                 
  114. ( Eratosthenes Sieve Benchmark, local variable version )
  115. : prime3 { | #primes  prime*2+3  limit -- } 
  116.     ( note different syntax for MF+)
  117.     ( note also that i + should be replaced by i+ etc. in MF+ )
  118.    flags  size 1 fill                         
  119.    flags size + -> limit  0 -> #primes 
  120.    
  121.    limit 1+  flags  
  122.    do  i c@                                     
  123.      if i flags - 2* 3 + dup -> prime*2+3       
  124.        i + limit <                              
  125.           if limit 1+   prime*2+3  i +          
  126.              do 0 i c! prime*2+3 +loop  ( 0ic! is one word  in MF+ )
  127.           then
  128.         #primes  1+  -> #primes                
  129.      then
  130.    loop
  131.    #primes .  ." primes " cr  ;
  132.  
  133. : sieve3 10 0 do prime3 loop ;
  134. : sieve3.demo counter sieve3 timer ;
  135.  
  136. : million.loops
  137.     counter 1000000 0 DO LOOP timer ;
  138.  
  139. ( floating point benchmarks )
  140. FP
  141.  
  142. : fmark1 pi 2.718281828e0 ." 10000 empty loops - "
  143.          counter 10000 0 do fover fover fdrop fdrop loop timer 
  144.          fdrop fdrop ;
  145. : fmark2 pi 2.718281828e0 ." 10000 additions - "
  146.          counter 10000 0 do fover fover f+ fdrop loop timer 
  147.          fdrop fdrop ;
  148. : fmark3 pi 2.718281828e0 ." 10000 subtractions - " 
  149.          counter 10000 0 do fover fover f- fdrop loop timer  
  150.          fdrop fdrop ;
  151. : fmark4 pi 2.718281828e0 ." 10000 multiplications - "
  152.          counter 10000 0 do fover fover f* fdrop loop timer  
  153.          fdrop fdrop ;
  154. : fmark5 pi 2.718281828e0 ." 10000 divisions - "
  155.          counter 10000 0 do fover fover f/ fdrop loop timer  
  156.          fdrop fdrop ;
  157. : fmark6 2.718281828e0 ." 1000 square roots - "
  158.          counter 1000 0 do fdup fsqrt fdrop loop timer  
  159.          fdrop ;
  160. : fmark7 2.718281828e0 ." 1000 sines - "
  161.          counter 1000 0 do fdup fsin  fdrop loop timer  
  162.          fdrop ;
  163. : fmark8 2.718281828e0 ." 1000 logarithms - "
  164.          counter 1000 0 do fdup fln fdrop loop timer  
  165.          fdrop ;
  166. : fmark9 2.718281828e0 ." 1000 exponentiations - "
  167.          counter 1000 0 do fdup faln fdrop loop timer  
  168.          fdrop ;
  169.  
  170. : fspeed.test cr
  171.     fmark1 cr
  172.     fmark2 cr
  173.     fmark3 cr
  174.     fmark4 cr
  175.     fmark5 cr
  176.     fmark6 cr
  177.     fmark7 cr
  178.     fmark8 cr
  179.     fmark9 cr
  180. ;
  181.  
  182.